﻿<%
'
'	七色虎建站系统
'	后台管理文件admin.asp
'	2012.3.2

If admin_conn<>1 Then Response.End

%>
<!--#include file="f.asp"-->
<!--#include file="db.asp"-->
<%
Dim bbsSidstr,Admin_Ip
hu_style = False'后台页面
bbsSidstr= bbsSid'取前台BBS设置
bbsSid = "sid"'后台页面
Admin_Ip=user_ip

'系统升级日志
Function getSystemUpdateLogs()
	getSystemUpdateLogs="1、改善内核，提升效率，修复一些错误<br/>"&_
		"2、论坛增加了会员等级,密保,称号系统<br/>"&_
		"3、论坛补充了会员封锁、解封监狱系统<br/>"&_
		"4、论坛补充了新会员限制注册管理功能<br/>"&_
		"5、文章和帖子增加了会员一键收藏功能<br/>"&_
		"6、文章和帖子增加QQ空间一键分享功能<br/>"&_
		"7、图片补充自动缩放功能,提供UBB标签<br/>"&_
		"8、改进了文件上传系统，提高管理效率<br/>"&_
		"9、特别补充网站系统错误排查检测工具<br/>"
End Function

If Not ifNum(adminSize) Then adminSize="0"'后台上传限制

Dim myconn,connstr,myconnstr
on error resume next

'实例后台连接
' connstr="DBQ="+server.mappath(""&dbm&"")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};pwd=;"
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database PASSWORD=;Data Source="&Server.MapPath(""&dbm&"")
set conn=server.createobject("ADODB.CONNECTION")
conn.open connstr

'实例前台连接
' myconnstr="DBQ="+server.mappath(""&db&"")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};pwd=;"
myconnstr="Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database PASSWORD=;Data Source="&Server.MapPath(""&db&"")
set myconn=server.createobject("ADODB.CONNECTION")
myconn.open myconnstr

'ip封锁
ipLockAdmin(Admin_Ip)

sub CloseConn()
	conn.close
	set conn=nothing
	myconn.close
	set myconn=nothing
end sub

Sub Head()
	Response.ContentType = "text/vnd.wap.wml; charset=utf-8"
	w "<?xml version=""1.0"" encoding=""utf-8""?>"&_
		"<!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.1//EN"" ""http://www.wapforum.org/DTD/wml_1.1.xml"">"&_
		"<wml>"&_
		"<head>"&_
		"<meta http-equiv=""Cache-Control"" content=""max-age=0""/>"&_
		"<meta http-equiv=""Cache-Control"" content=""no-cache""/>"&_
		"</head>"
End Sub

Sub Head2()
	Response.ContentType = "text/html; charset=utf-8"
	w "<?xml version=""1.0"" encoding=""utf-8""?>"&_
		"<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">"&_
		"<html xmlns=""http://www.w3.org/1999/xhtml"">"&_
		"<head>"&_
		"<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8""/>"
End Sub

Sub Last()
	Call closeconn()
	w "<br/><a href=""../index.asp?sid="&sid&""">[后台管理]</a><br/>"&timeout&"</p></card></wml>"
	Response.End
End Sub

Sub Last2()
	Call closeconn()
	w "<br/><a href=""../index.asp?sid="&sid&""">[后台管理]</a><br/>"&timeout&"</body></html>"
	Response.End
End Sub

Sub rootLast()
	Call closeconn()
	w "<br/><a href=""index.asp?sid="&sid&""">[后台管理]</a><br/>"&timeout&"</p></card></wml>"
	Response.End
End Sub

Sub rootLast2()
	Call closeconn()
	w "<br/><a href=""index.asp?sid="&sid&""">[后台管理]</a><br/>"&timeout&"</body></html>"
	Response.End
End Sub

Sub Error(erstr)
	Call closeconn()
	Response.write erstr &"<br/><a href=""index.asp?sid="&sid&""">[返回管理]</a><br/>"&timeout&"</p></card></wml>"
	Response.end
end Sub

Sub Error2(erstr)
	Call closeconn()
	Response.write erstr &"<br/><a href=""index.asp?sid="&sid&""">[返回管理]</a><br/>"&timeout&"</body></html>"
	Response.end
end Sub

Function timeout()
	if adminTimeCheck=0 or IsDate(HU_logintime)=False then timeout="":Exit Function
	Dim time_
	time_ = DateAdd("n",25,time_now)
	timeout = "离线时间 "&fordate2(time_)&""
End Function

'生成唯一的sid值，使用时要引用md5以及建立连接
Function onlysid()
	Dim tmp_,count_
	tmp_=md5(md5(hu_randomize,16),32)
	count_=conn.Execute("select count(id) from 74hu_admin where sid='"&tmp_&"'")(0)
	if count_<>0 then tmp_=onlysid()
	onlysid=tmp_
End Function

'时间命名的函数
function addwml(fname)
	fname = fname '前fname为变量，后fname为函数参数引用
	fname = replace(fname,"-","")
	fname = replace(fname," ","")
	fname = replace(fname,":","")
	fname = replace(fname,"PM","")
	fname = replace(fname,"AM","")
	fname = replace(fname,"上午","")
	fname = replace(fname,"下午","")
	addwml = fname & ".wml"
end function

'文件内容读取
Function LoadFile(File)
	Dim objStream
	On Error Resume Next
	Set objStream = Server.CreateObject("ADODB.Stream")
		If Err.Number=-2147221005 Then
		Response.Write "非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序"
		Err.Clear
		Response.End
		End If
	With objStream
	.Type = 2
	.Mode = 3
	.Open
	.LoadFromFile Server.MapPath(File)
		If Err.Number<>0 Then
		Response.Write "文件"&File&"无法被打开，请检查是否存在!"
		Err.Clear
		Response.End
		End If
	.Charset = "utf-8"
	.Position = 2
	LoadFile = .ReadText
	.Close
	End With
	Set objStream = Nothing
End Function

'存储内容到文件
Sub SaveToFile(strBody,File)
	Dim objStream
	On Error Resume Next
	Set objStream = Server.CreateObject("ADODB.Stream")
		If Err.Number=-2147221005 Then
		Response.Write "非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序"
		Err.Clear
		Response.End
		End If
	With objStream
	.Type = 2
	.Open
	.Charset = "utf-8"
	.Position = objStream.Size
	.WriteText = strBody
	.SaveToFile Server.MapPath(File),2
	.Close
	End With
	Set objStream = Nothing
End Sub

'IP封锁
Sub ipLockAdmin(str)
	Dim IpArray,WhyIpLock,IpSQL,IpRS
	IpArray=split(str,".")
	IpSQL="SELECT iplock From 74hu_IpLock Where  "& _
	" (ipsame=4 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" and ip3="&Cint(IpArray(2))&" and ip4="&Cint(IpArray(3))&" )  "& _
	" Or (ipsame=3 and  ip1="&Cint(IpArray(0))&"  and  ip2="&Cint(IpArray(1))&"  and  ip3="&Cint(IpArray(2))&" )   "& _
	" Or (ipsame=2 and ip1="&Cint(IpArray(0))&" and ip2="&Cint(IpArray(1))&" ) Or (ipsame=1 and ip1="&Cint(IpArray(0))&" ) Order By ipid "
	Set IpRS=myConn.execute(IpSQL)
	If Not (IpRS.bof or IpRS.eof) Then
		WhyIpLock=split(IpRS("iplock"),"|")
		Response.write "<card title=""出错了""><p>你使用的IP段或IP地址已被封锁<br/>封锁原因:"&WhyIpLock(1)&"<br/>封锁时间:"&WhyIpLock(0)&"</p></card></wml>"
		Response.End
		Set myConn=nothing
	End If
	Set IpRS=Nothing
End Sub

'判断文件类型是否合格
Function CheckFileExtSafe(fileEXT)
	dim Forumupload
	Forumupload="asp,php,exe,aspx,cgi,html,htm,shtml,jsp,inc,bat"
	Forumupload=split(Forumupload,",")
	for i=0 to ubound(Forumupload)
		if lcase(fileEXT)=lcase(trim(Forumupload(i))) then
			CheckFileExtSafe=true
			exit Function
		else
			CheckFileExtSafe=false
		end if
	next
End Function

'生成样式文件
Sub buildCssByStyle(style)
	Dim bodywidth,mainwidth,fontsize,bodycolor,bodyimage,maincolor,mainborder,navcolor,navborder,linkcolor,linkhover,tipcolor,oddcolor,cssextend,cssFile,cssConfig
	If style="2" Then bodywidth="width:250px;":mainwidth="width:240px;"
	If styleFontSize<>"" Then fontsize = "font-size:"&styleFontSize&"px;"
	If styleBodyColor<>"" Then bodycolor = "background-color:"&styleBodyColor&";"
	'取消背景图片
	' If styleBodyImage<>"" And Replace(styleBodyImage,"/","")<>"" Then bodyimage = "background-image:url('"&styleBodyImage&"');"
	If styleMainColor<>"" Then maincolor = "background:"&styleMainColor&";"
	If styleMainBorder<>"" Then mainborder = "border:1px solid "&styleMainBorder&";"
	If styleNavColor<>"" Then navcolor = "background:"&styleNavColor&";"
	If styleNavBorder<>"" Then navborder = "border-top:1px solid "&styleNavBorder&";border-bottom:1px solid "&styleNavBorder&";"
	If styleLinkColor<>"" Then linkcolor = "color:"&styleLinkColor&";"
	If styleLinkHover<>"" Then linkhover = "color:"&styleLinkHover&";"
	If styleTipColor<>"" Then tipcolor = "color:"&styleTipColor&";"
	If styleOddColor<>"" Then oddcolor = "background:"&styleOddColor&";"
	If styleCssExtend<>"" Then cssextend = styleCssExtend
	cssFile= "../../config/css.asp"'生成css.asp文件路径
	cssConfig = "<"&"%"&chr(13)&chr(10)&_
	  "cssStyle=""body{text-align:center;margin:0 auto;padding:0px;font-family:Verdana,Arial,Helvetica,sans-serif;"&fontsize&bodycolor&bodyimage&bodywidth&"}"&_
	  ".main{text-align:left;word-wrap:break-word;overflow:hidden;padding:5px;"&maincolor&mainborder&mainwidth&"}"&_
	  ".nav{padding:1px;"&navcolor&navborder&"}"&_
	  ".tle{font-weight:bold;text-align:center}"&_
	  ".odd{padding:3px;"&oddcolor&"}"&_
	  ".even{padding:3px}"&_
	  "a{text-decoration:none;"&linkcolor&"}"&_
	  "a:hover{text-decoration:underline;"&linkhover&"}"&_
	  "img,a img{border:none;padding:0 2px 0 1px;}"&_
	  "input,div{margin:1px 0 1px 0;}"&_
	  "form{margin:0px;display:inline}"&_
	  ".tip{"&tipcolor&"}"&cssextend&""" 'Css样式"&_
	  chr(13)&chr(10)&"%"&">"
	Call savetofile(cssConfig,cssFile)
End Sub

'重写文章重复检测
Function ifArticleRepeat(title)
	ifArticleRepeat=False
	If 0<>myconn.execute("select count(id) from 74hu_article where title='"&title&"'")(0) Then ifArticleRepeat=True
End Function

'系统信息，检查新留言，友链，投稿
Function systemMsg()
	Dim rs_
	rs_=myconn.Execute("select count(id) from 74hu_guest where retext=''")(0)
	If rs_>0 Then
		systemMsg = "系统：<a href=""lygl/index.asp?sid="&sid&""">有"&rs_&"条新留言</a><br/>"
	Else
		rs_=myconn.Execute("select count(id) from 74hu_link where active=1 and del=0")(0)
		If rs_>0 Then
			systemMsg = "系统：<a href=""link/mymin_link.asp?sid="&sid&""">有"&rs_&"条友链未审核</a><br/>"
		Else
			rs_=myconn.Execute("select count(id) from 74hu_article where classid=0")(0)
			If rs_>0 Then systemMsg = "系统：<a href=""art/adminsmscl.asp?sid="&sid&"&amp;id=0"">有"&rs_&"篇投稿未审核</a><br/>"
		End If
	End If
End Function

'系统信息，检查新留言，友链，投稿
Function systemMsgRoot()
	Dim rs_
	rs_=myconn.Execute("select count(id) from 74hu_guest where retext=''")(0)
	If rs_>0 Then
		systemMsgRoot = "系统：<a href=""../lygl/index.asp?sid="&sid&""">有"&rs_&"条新留言</a><br/>"
	Else
		rs_=myconn.Execute("select count(id) from 74hu_link where active=1 and del=0")(0)
		If rs_>0 Then
			systemMsgRoot = "系统：<a href=""../link/mymin_link.asp?sid="&sid&""">有"&rs_&"条友链未审核</a><br/>"
		Else
			rs_=myconn.Execute("select count(id) from 74hu_article where classid=0")(0)
			If rs_>0 Then systemMsgRoot = "系统：<a href=""../art/adminsmscl.asp?sid="&sid&"&amp;id=0"">有"&rs_&"篇投稿未审核</a><br/>"
		End If
	End If
End Function

'后台发送信息给会员
Sub sendMsgToUser(userid, msg)
	myconn.Execute("insert into 74hu_message (userid,receive,savetime,content,state,flag)values(0,"&userid&",'"&time_now&"','"&msg&"',0,0)")
End Sub

'后台发广播，最多保留3条
' Function postBroadcast(msg,closetime)
	' Dim count
	' count = myconn.Execute("select count(id) from 74hu_broadcast")(0)
	' If count>=3 Then
		' postBroadcast = 0
		' Exit Function
	' End If
	' myconn.Execute("insert into 74hu_broadcast(savetime,content,closetime,reader)values('"&time_now&"','"&msg&"','"&closetime&"','')")
	' postBroadcast = 1
' End Function

'会员增减金币,积分,经验
Function calcUserAmount(userid, rules)
	Dim ruleArray,money,points,expr
	ruleArray = Split(rules&"",",")
	If UBound(ruleArray)<2 Then calcUserAmount="": Exit Function
	money = ruleArray(0)
	points = ruleArray(1)
	expr = ruleArray(2)
	If hu_isNumber(money) And hu_isNumber(points) And hu_isNumber(expr) And userid>0 Then
		If money>=0 Then money="+"&money
		If points>=0 Then points="+"&points
		If expr>=0 Then expr="+"&expr
		myconn.Execute("update 74hu_user set [money]=[money]"&money&",[points]=[points]"&points&",[experience]=[experience]"&expr&" where id="&userid)
		calcUserAmount=""&bbsMoney&""&money&","&bbsPoint&""&points&",经验"&expr
	End If
End Function

'清除缓存
Sub cache(str)
	If str Then Exit Sub
	Response.Buffer = True
	Response.Expires = 0
	Response.ExpiresAbsolute = time_now - 1
	Response.CacheControl = "no-cache"
	Response.AddHeader "Expires",time_date
	Response.AddHeader "Pragma","no-cache"
	Response.AddHeader "Cache-Control","private, no-cache, must-revalidate"
End Sub

%>